home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / guile-ii.src / guile-ii / guile-src / gls / modops.scm < prev    next >
Encoding:
Text File  |  1995-08-03  |  30.1 KB  |  842 lines
  1. ;;; $Id: modops.scm,v 1.7 1995/01/07 21:48:02 miles Exp $
  2. ;;; ----------------------------------------------------------------
  3. ;;; modops.scm -- User-level interface to Guile's module system
  4. ;;; 2 Dec 1994, Miles Bader <miles@eskimo.com>
  5. ;;; ----------------------------------------------------------------
  6. ;;;
  7. ;;; Common operations (these are all macros, and with the exception of VALUE
  8. ;;; in define-export, no arguments are evaluated):
  9. ;;;
  10. ;;;    (in-module NAME)
  11. ;;;        Sets the current module to NAME in the current package, and the
  12. ;;;        current interface to an interface with the same name.
  13. ;;;    (use-interface OPERATORS...)
  14. ;;;        Imports variables from other interfaces into the current module.
  15. ;;;        The most common use is just (use-interface NAME).
  16. ;;;    (export-interface NAME OPERATORS...)
  17. ;;;        Exports variables from the current module into the interface
  18. ;;;        called NAME in the current package.
  19. ;;;        The most common use is (export-interface NAME (VARIABLE-NAME ...)).
  20. ;;;    (export-interfaces-to-library NAME)
  21. ;;;        Asserts that all subsequent interfaces exported from this module
  22. ;;;        are to be themselves exported to LIBRARY.
  23. ;;;
  24. ;;;    (in-package NAME)
  25. ;;;        Sets the current package to the package called NAME.  Until a
  26. ;;;        subsequent in-module, the current module will be a special one in
  27. ;;;        which package definition operators can be executed.
  28. ;;;    (use-library OPERATORS...)
  29. ;;;        Imports interfaces from other libraries into the current package.
  30. ;;;        The most common use is just (use-library NAME).
  31. ;;;        This function may also be used after an in-module, in which case,
  32. ;;;        it only applies to that module.
  33. ;;;    (export-library NAME OPERATORS...)
  34. ;;;        Exports interfaces from the current package into the library
  35. ;;;        called NAME.
  36. ;;;        The most common use is (export-library NAME (INTERFACE-NAME ...)).
  37. ;;;
  38. ;;;    (in-interface NAME)
  39. ;;;        Sets the `current interface' to NAME in the current package.
  40. ;;;    (export OPERATORS...)
  41. ;;;        Like export-interface, but exports to the current interface.
  42. ;;;    (define-export SYMBOL VALUE)
  43. ;;;        Like define, but also exports SYMBOL to the current interface.
  44. ;;;
  45. ;;; ----------------
  46. ;;; A typical file using these module operators might look like:
  47. ;;;
  48. ;;;   (in-package extensions)
  49. ;;;   (in-module foo)
  50. ;;;
  51. ;;;   (use-library slib)
  52. ;;;
  53. ;;;   ;; Export routines to deal with foos
  54. ;;;   (export-interface foo (make-foo foo-blah string->foo))
  55. ;;;
  56. ;;;   ;; Add modules we use to our search path
  57. ;;;   (use-interface guile)
  58. ;;;   (use-interface struct)
  59. ;;;   (use-interface i/o)
  60. ;;;
  61. ;;;   (define (make-foo) ...)
  62. ;;;   ...
  63. ;;;
  64. ;;; Instead of EXPORT-INTERFACE, we could have used EXPORT, which exports to
  65. ;;; the `current interface' (which is initially set by IN-MODULE to an
  66. ;;; interface with the same name as the current module).  Or alternatively,
  67. ;;; there could have been no export statement at all, and we could have used
  68. ;;; DEFINE-EXPORT instead of DEFINE for each symbol that we wished to export
  69. ;;; (DEFINE-EXPORT exports to the current interface like EXPORT does). 
  70. ;;;
  71. ;;; ----------------
  72. ;;; Here are some examples of more complex uses:
  73. ;;;
  74. ;;;   ;; Imports the symbols AND, OR, and NOT from the scheme interface
  75. ;;;   (use-interface scheme (and or not))
  76. ;;;   
  77. ;;;   ;; Imports everything from the graphics interface with a prefix of
  78. ;;;   ;; "graphics:" 
  79. ;;;   (use-interface graphics "graphics:")
  80. ;;;   
  81. ;;;   ;; Imports all symbols from the graphics interface with a prefix of
  82. ;;;   ;; "graphics:", *except* the symbol BITBLT, which is imported as is,
  83. ;;;   ;; and the symbol CLEAR-SCREEN, which is imported as CLS (note that if
  84. ;;;   ;; you want explicitly imported symbols to be prefixed, you must
  85. ;;;   ;; supply the prefix yourself).
  86. ;;;   (use-interface graphics (bitblt (clear-screen cls)) "graphics:")
  87. ;;;   
  88. ;;;   ;; Exports the symbols X, Y, and Z (from the current module) as the
  89. ;;;   ;; interface FOO
  90. ;;;   (export-interface foo (x y z))
  91. ;;;   
  92. ;;;   ;; Exports as the interface FOO the symbols A, B, and C from the
  93. ;;;   ;; current module, and all symbols from the interface BLAH with a
  94. ;;;   ;; prefix of "blah:"
  95. ;;;   (export-interface foo (a b c) blah "blah:")
  96. ;;;    
  97. ;;; ----------------
  98. ;;; The following primitive module routines are used:
  99. ;;;   (make-variable VALUE [NAME-HINT]) => VARIABLE
  100. ;;;   (make-undefined-variable [NAME-HINT]) => VARIABLE
  101. ;;;   (variable-set! VARIABLE VALUE)
  102. ;;;   (variable-ref VARIABLE) => VALUE
  103. ;;;   (variable-bound? VARIABLE) => #t | #f
  104. ;;; 
  105. ;;;   (make-module [HASH-TABLE-SIZE]) => MODULE
  106. ;;;   (module? THING) => #t | #f
  107. ;;;   (module-uses MODULE) => MODULE-LIST
  108. ;;;   (module-uses! MODULE MODULE-LIST)
  109. ;;; 
  110. ;;;   (module-add! MODULE SYMBOL VARIABLE)
  111. ;;;   (module-remove! MODULE SYMBOL)
  112. ;;;   (module-for-each FUN MODULE)
  113. ;;;   (module-local-variable MODULE SYMBOL) => VARIABLE | #f
  114. ;;;   (module-variable MODULE SYMBOL) => VARIABLE | #f
  115. ;;;   (module-bound? MODULE SYMBOL) => #t | #f
  116. ;;;
  117. ;;;   (module-id MODULE) => STRING | #f
  118. ;;;   (module-set-id! MODULE STRING)
  119. ;;;   
  120. ;;;   (set-current-module MODULE)
  121. ;;;   (current-module)
  122. ;;; ----------------
  123.  
  124. (define module-uses! module-uses-set!)
  125.  
  126. ;;; ----------------------------------------------------------------
  127. ;;; Bootstrap the module system... presumably the current module is
  128. ;;; the scheme module holding a normal scheme system at this point.  In any
  129. ;;; case, we use the current module to get access to everything we need...
  130. ;;;
  131. ;;; More initialization is done at the end of this file.
  132. ;;;
  133. (define *boot-module* (current-module))
  134.  
  135. (define *module-module* (make-module))
  136. (module-uses! *module-module* (list *boot-module*))
  137. (set-current-module *module-module*)
  138.  
  139. ;; Initial hash-table sizes for various sorts of modules
  140. (define *user-module-size* 519)
  141. (define *interface-module-size* 57)
  142. (define *search-module-size* 7)
  143. (define *package-module-size* 57)
  144. (define *package-init-module-size* 7)
  145.  
  146. ;;; defines a macro that executes BODY without evaluating arguments
  147. (define-macro (define-neval template . body)
  148.   `(define-macro ,template `(,(lambda () ,@body))))
  149.  
  150. ;;; ----------------------------------------------------------------
  151. ;;; handy module procedures (exported)
  152.  
  153. ;; MODULE-REF -- exported
  154. ;;
  155. ;; Returns the value of a variable called NAME in MODULE or any of its
  156. ;; used modules.  If there is no such variable, then if the optional third
  157. ;; argument DEFAULT is present, it is returned; otherwise an error is signaled.
  158. ;; 
  159. (define (module-ref module name . rest)
  160.   (let ((variable (module-variable module name)))
  161.     (if (and variable (variable-bound? variable))
  162.     (variable-ref variable)
  163.     (if (null? rest)
  164.         (error "No variable named" name 'in module)
  165.         (car rest)            ; default value
  166.         ))))
  167.  
  168. ;; MODULE-SET! -- exported
  169. ;;
  170. ;; Sets the variable called NAME in MODULE (or in a module that MODULE uses)
  171. ;; to VALUE; if there is no such variable, an error is signaled.
  172. ;; 
  173. (define (module-set! module name value)
  174.   (let ((variable (module-variable module name)))
  175.     (if variable
  176.     (variable-set! variable value)
  177.     (error "No variable named" name 'in module))))
  178.  
  179. ;; MODULE-DEFINE -- exported
  180. ;;
  181. ;; Sets the variable called NAME in MODULE to VALUE; if there is no such
  182. ;; variable, it is added first.
  183. ;; 
  184. (define (module-define module name value)
  185.   (let ((variable (module-local-variable module name)))
  186.     (if variable
  187.     (variable-set! variable value)
  188.     (module-add! module name (make-variable value name)))))
  189.  
  190. ;; MODULE-USE! -- internal
  191. ;;
  192. ;; Add INTERFACE to the list of interfaces used by MODULE.
  193. ;; 
  194. (define (module-use! module interface)
  195.   (module-uses! module
  196.         (cons interface (delq! interface (module-uses module)))))
  197.  
  198. ;; MAKE-USER-MODULE -- internal
  199. ;;
  200. ;; Creates a module with a proper initial use list for use as a source module.
  201. ;; 
  202. (define (make-user-module)
  203.   (let ((module (make-module)))
  204.     (module-uses! module (list *module-basics-interface*))
  205.     module))
  206.  
  207. ;; ----------------------------------------------------------------
  208.  
  209. (define (%make-interface)
  210.   (let ((interface (make-module *interface-module-size*)))
  211.     (module-set-kind! interface 'interface)
  212.     interface))
  213.  
  214. ;; This is the interface automatically used by modules created by IN-MODULE
  215. (define *module-basics-interface* (%make-interface))
  216.  
  217. ;; This is the interface automatically used by a package's initial-module
  218. ;; (which is the current-module while defining package attributes).
  219. (define *package-basics-interface* (%make-interface))
  220.  
  221. ;; ----------------------------------------------------------------
  222.  
  223. ;; DEFINE-MODULE-ATTRIBUTE -- internal
  224. ;; 
  225. ;; Various module attributes are stored using unique variable names in
  226. ;; the module.  As the symbol used is not interned, it is guaranteed not to
  227. ;; conflict with any user-bindings in the module.
  228. ;; 
  229. ;; This macro defines accessors that can be used to get/set an attribute with
  230. ;; the given name in a module.  [Because the symbol used is unique, the name
  231. ;; is just for debugging purposes]
  232. ;; 
  233. (define-macro (define-module-attribute name getproc-name setproc-name)
  234.   `(begin
  235.      (define ,getproc-name #f)
  236.      (define ,setproc-name #f)
  237.      (let ((variable-name (string->obarray-symbol #f ,name)))
  238.        (set! ,getproc-name
  239.          (lambda (lib) (module-ref lib variable-name #f)))
  240.        (set! ,setproc-name
  241.          (lambda (lib val) (module-define lib variable-name val))))))
  242.  
  243. ;;; ----------------------------------------------------------------
  244. ;;; Packages -- namespaces for modules
  245. ;;; 
  246.  
  247. ;; Each package represents two namespaces -- interfaces & modules.
  248. ;; Interfaces are stored directly in a package module; modules are stored in
  249. ;; a second module bound to a special variable name in the package module.
  250. ;; 
  251. (define-module-attribute "modules"
  252.   package-modules package-set-modules!)
  253.  
  254. ;; Each package has an `initial module' which is the current module after
  255. ;; an in-package makes it the current package.  This module is slightly
  256. ;; different than a normal module, and most module operations can't be done
  257. ;; in it -- a call to in-module must be done first.
  258. ;; 
  259. (define-module-attribute "initial-module"
  260.   package-initial-module package-set-initial-module!)
  261.  
  262. ;; MAKE-PACKAGE -- internal
  263. ;; 
  264. (define (make-package)
  265.   (let ((package (make-module *package-module-size*))
  266.     (init-module (make-module *package-init-module-size*)))
  267.     ;; define the special initial module
  268.     (module-uses! init-module (list *package-basics-interface*))
  269.     (module-set-package! init-module package)
  270.     (module-set-search-space! init-module package)
  271.     ;;
  272.     (package-set-modules! package (make-module *package-module-size*))
  273.     (package-set-initial-module! package init-module)
  274.     (module-set-kind! package 'package)
  275.     package))
  276.  
  277. ;; PACKAGE? -- internal
  278. ;;
  279. (define (package? thing)
  280.   (and (module? thing) (package-modules thing) #t))
  281.  
  282. ;; package-interface -- internal
  283. ;;
  284. ;; Returns from PACKAGE the interface called NAME, and DEFAULT if it isn't
  285. ;; found
  286. ;; 
  287. (define package-interface module-ref)
  288.  
  289. ;; PACKAGE-ADD-INTERFACE! -- internal
  290. ;;
  291. ;; Returns from PACKAGE the interface called NAME, and DEFAULT if it isn't
  292. ;; found
  293. ;; 
  294. (define package-add-interface! module-define)
  295.  
  296. ;; PACKAGE-MODULE, PACKAGE-ADD-MODULE! -- internal
  297. ;;
  298. ;; Like the previous two routines, but for modules instead of interfaces.
  299. ;; 
  300. (define (package-module package name . rest)
  301.   (apply module-ref (package-modules package) name rest))
  302. (define (package-add-module! package name value)
  303.   (module-define (package-modules package) name value))
  304.  
  305. ;;; ----------------------------------------------------------------
  306. ;;; Module package attributes
  307. ;;; 
  308.  
  309. ;; MODULE-PACKAGE, MODULE-SET-PACKAGE! -- internal
  310. ;; 
  311. ;; This is the package where module references are resolved (e.g., for
  312. ;; in-module), and new modules are created.
  313. ;;
  314. (define-module-attribute "package"
  315.   module-package module-set-package!)
  316.  
  317. ;; MODULE-SEARCH-PACKAGE, MODULE-SET-SEARCH-SPACE! -- internal
  318. ;;
  319. ;; This is the package where interface references are resolved.   It separate
  320. ;; from (current-package) so that modules may have their own private
  321. ;; search-space (although this package should always use (current-package)).
  322. ;; 
  323. (define-module-attribute "search-space"
  324.   module-search-space module-set-search-space!)
  325.  
  326. ;; MODULE-EXPORT-LIBRARY, MODULE-SET-EXPORT-LIBRARY! -- internal
  327. ;;
  328. ;; When not #f, this is a library to which any exported interfaces are
  329. ;; exported to in addition to the current package.
  330. ;; 
  331. (define-module-attribute "export-library"
  332.   module-export-library module-set-export-library!)
  333.  
  334. ;;; ----------------------------------------------------------------
  335. ;;; Routines to resolve interface/module names.
  336. ;;; 
  337.  
  338. (define (name-module! module id package)
  339.   ;; Give the module a nice name for printing
  340.   (let ((package-name (module-name package))
  341.     (leaf-name (symbol->string id)))
  342.     (module-set-name!
  343.      module 
  344.      (if package-name
  345.      (string-append package-name "/" leaf-name)
  346.      leaf-name))))
  347.  
  348. ;; RESOLVE-INTERFACE -- internal
  349. ;;
  350. ;; Returns the interface module corresponding to INTREF (if a symbol, it is
  351. ;; looked up in PACKAGE).  If it isn't found, it is created in PACKAGE, and
  352. ;; also exported to any non-#f elements of LIBRARIES (this hack to support
  353. ;; export-interfaces-to-library).
  354. ;; 
  355. (define (resolve-interface intref package . export-libraries)
  356.   (if (symbol? intref)
  357.       (or (package-interface package intref #f)
  358.       (let ((interface (%make-interface)))
  359.         (package-add-interface! package intref interface)
  360.         (name-module! interface intref package)
  361.         (do ((libs export-libraries (cdr libs)))
  362.         ((null? libs))
  363.           (if (car libs)
  364.           (import-variable intref package intref (car libs))))
  365.         interface))
  366.       intref))
  367.  
  368. ;; RESOLVE-MODULE -- internal
  369. ;;
  370. ;; Returns the implementation module corresponding to MODREF (if a symbol, it
  371. ;; is looked up in PACKAGE).  If the module has to be created, CREATOR will
  372. ;; be called to do so.
  373. ;; 
  374. (define (resolve-module modref package creator)
  375.   (if (symbol? modref)
  376.       (or (package-module package modref #f)
  377.       (let ((module (creator))
  378.         ;; The new module gets a private package to be its search
  379.         ;; space for libraries, which inherits from its package.
  380.         (search-space (make-module *search-module-size*)))
  381.         (package-add-module! package modref module)
  382.         ;;
  383.         (module-uses! search-space (list package))
  384.         ;; Setup the module attributes
  385.         (module-set-package! module package)
  386.         (module-set-search-space! module search-space)
  387.         (name-module! module modref package)
  388.         module))
  389.       modref))
  390.  
  391. ;;; ----------------------------------------------------------------
  392.  
  393. ;; FIND-INTERFACE -- internal
  394. ;;
  395. ;; Returns the interface named NAME in PACKAGE, loading external code somehow
  396. ;; if necessary to define it.  If no such interface can be found, and CREATE?
  397. ;; is true, a new interface in PACKAGE is returned, otherwise #f is returned.
  398. ;; 
  399. (define (find-interface name package create?)
  400.   (let ((interface (package-interface package name #f)))
  401.     (if (module? interface)
  402.     interface
  403.     (or (package-load-interface package name interface)
  404.         (and create? (resolve-interface name package))))))
  405.  
  406. ;; FIND-MODULE -- internal
  407. ;;
  408. ;; Returns the module named NAME in PACKAGE, loading external code somehow if
  409. ;; necessary to define it.  If no such module can be found, and CREATOR is
  410. ;; not #f, it is called to create the module, otherwise #f is returned.
  411. ;; 
  412. (define (find-module name package creator)
  413.   (let ((module (package-module package name #f)))
  414.     (if (module? module)
  415.     module
  416.     (or (package-load-module package name module)
  417.         (and creator (resolve-module name package creator))))))
  418.  
  419. ;;; ----------------------------------------------------------------
  420. ;;; For the common case, where someone just wants to have a single exported
  421. ;;; interface, we maintain a default interface with the same name as the
  422. ;;; module...
  423. ;;; 
  424.  
  425. (define-module-attribute "current-interface"
  426.   module-current-interface module-set-current-interface!)
  427.  
  428. ;; SET-CURRENT-INTERFACE -- exported
  429. ;; 
  430. ;; Sets the `current interface' to INTREF; if this is a symbol, no
  431. ;; interface is actually created until something is exported to it.
  432. ;; 
  433. (define (set-current-interface intref)
  434.   (module-set-current-interface! (current-module) intref))
  435.  
  436. ;; CURRENT-INTERFACE -- exported
  437. ;; 
  438. ;; Returns the module which is the current default exported interface
  439. ;; for the current module.
  440. ;; 
  441. (define (current-interface)
  442.   (let* ((mod (current-module))
  443.      (interface (module-current-interface mod)))
  444.     (cond ((eq? interface #f)
  445.        (error "No current interface"))
  446.       ((not (module? interface))
  447.        ;; not resolved yet, ensure it exists
  448.        (set! interface
  449.          (resolve-interface interface
  450.                     (module-package mod)
  451.                     (module-export-library mod)))
  452.        (set-current-interface interface)))
  453.     interface))
  454.  
  455. ;;; ----------------------------------------------------------------
  456.  
  457. ;; MAKE-INTERFACE -- exported
  458. ;; 
  459. ;; Returns an interface module sharing variables with other modules, imported
  460. ;; according to OPERATORS (see extend-interface for more info on these).
  461. ;; PACKAGE is the namespace used to resolve interface references.
  462. ;; 
  463. (define (make-interface package . operators)
  464.   (apply extend-interface #f package operators))
  465.  
  466. ;; EXTEND-INTERFACE -- internal
  467. ;;
  468. ;; Add to the interface module EXPORTING-TO variables imported from other
  469. ;; modules, according to OPERATORS.  If EXPORTING-TO is #f, an empty
  470. ;; interface is created to export to.  PACKAGE is the namespace used to
  471. ;; resolve interface references.
  472. ;;
  473. ;; Each OPERATOR is either:
  474. ;;   A module, in which case it becomes the `currently being imported' module,
  475. ;;   A symbol, in which case it is looked up as the name of an interface
  476. ;;     module, which becomes the `currently being imported' module, or
  477. ;;   #f, which turns off the implicit importation of the whole interface when
  478. ;;     no explicit imports are given.
  479. ;;   Something to import from the `currently being imported' module.  See the
  480. ;;     procedure import, below, for what these can be.  If no imports are
  481. ;;     given for a given interface, by default everything in the interface is
  482. ;;     imported (this behavior can be suppressed by using the #f operator).
  483. ;; 
  484. (define (extend-interface exporting-to package . operators)
  485.   (let ((importing-from #f)
  486.     (auto-import? #t)        ; If true, implicitly import rest
  487.     (imported '()))
  488.     (letrec ((do-import
  489.           (lambda (what)
  490.         (if (not exporting-to)
  491.             (set! exporting-to (%make-interface)))
  492.         (set! imported
  493.               (import what exporting-to importing-from imported))))
  494.          (finish-importing
  495.           (lambda ()
  496.         ;; If nothing imported explicitly, import everything implicitly
  497.         (if (and auto-import? (null? imported))
  498.             (do-import #t))))
  499.          (new-interface
  500.           (lambda (module)
  501.         (if importing-from (finish-importing))
  502.         (set! importing-from module)
  503.         (set! imported '())
  504.         (set! auto-import? #t))))
  505.       (do ((operators operators (cdr operators)))
  506.       ((eq? operators '())
  507.        (cond ((not exporting-to)
  508.           ;; optimization: importing everything from a single
  509.           ;; interface to a null destination will just return the
  510.           ;; source interface itself.
  511.           importing-from)
  512.          (#t
  513.           ;; otherwise just do it the slow way
  514.           (finish-importing)
  515.           exporting-to)))
  516.     (let ((operator (car operators)))
  517.       (cond ((module? operator)
  518.          (new-interface operator))
  519.         ((symbol? operator)
  520.          (let ((interface (find-interface operator package #f)))
  521.            (if (not interface)
  522.                (error "Cannot import from" operator '-- ' no 'such
  523.                   'interface))
  524.            (new-interface interface)))
  525.         ((eq? operator #f)
  526.          (set! auto-import? #f))
  527.         (#t
  528.          (do-import operator))))))))
  529.  
  530. ;; IMPORT -- internal
  531. ;;
  532. ;; Imports WHAT from the module FROM to the module TO.  ALREADY-IMPORTED is
  533. ;; either a list of symbols already imported, or #t, meaning all symbols; an
  534. ;; updated version of ALREADY-IMPORTED reflecting this import is returned.
  535. ;;
  536. ;; WHAT is either:
  537. ;;    A list, in which each element is either:
  538. ;;      A symbol, which is imported, or
  539. ;;      A sublist of two elements, the symbol in FROM, and the resulting
  540. ;;        symbol that should be imported into TO (if the sublist has only one
  541. ;;        element, then this variable isn't imported).
  542. ;;    #t, meaning all symbols in FROM not in ALREADY-IMPORTED.
  543. ;;    A string, meaning all symbols in FROM not in ALREADY-IMPORTED, with the
  544. ;;      additional result that each imported symbol has the string added as a
  545. ;;      prefix before it is imported into TO.
  546. ;; 
  547. (define (import what to from already-imported)
  548.   (cond ((list? what)
  549.      ;; Import individual symbols, possibly with renaming
  550.      (do ((imports what (cdr imports))
  551.           (remember-imports? (list? already-imported))
  552.           (added '()))
  553.          ((null? imports)
  554.           (if remember-imports?
  555.           (append! added already-imported)
  556.           #t))
  557.        (let* ((import (car imports))
  558.           (what (if (symbol? import) import (car import)))
  559.           (as
  560.            (if (symbol? import)
  561.                import
  562.                (and (not (null? (cdr import)))
  563.                 (cadr import)))))
  564.          (if remember-imports? (set! added (cons what added)))
  565.          (if as (import-variable what from as to)))))
  566.     ((eq? already-imported #t)
  567.      ;; Import all remaining symbols -- but they've already all been done
  568.      #t)
  569.     (#t
  570.      ;; Import all remaining symbols, possibly with a prefix
  571.      (module-for-each
  572.       (lambda (symbol variable)
  573.         (if (not (memq symbol already-imported)) ; only import new things
  574.         (let ((as
  575.                (if (string? what)   ; see if there's a prefix
  576.                (string->symbol  ; if so, add it to the symbol
  577.                 (string-append what (symbol->string symbol)))
  578.                symbol)))        ; otherwise take the symbol as-is
  579.           (module-add! to as variable))))
  580.       from)
  581.      #t)))
  582.  
  583. ;; IMPORT-VARIABLE -- internal
  584. ;;
  585. ;; Associates the symbol AS in the module TO with the same variable as that
  586. ;; associated with the symbol NAME in the module FROM.  NAME must already
  587. ;; exist in FROM unless FROM is (current-module), in which case this is
  588. ;; assumed to be an export, and more liberal rules apply.
  589. ;;
  590. ;; Returns the shared variable (if the import can't be done, an error is
  591. ;; signaled).
  592. ;; 
  593. (define (import-variable name from as to)
  594.   (let ((source-variable (module-local-variable from name))
  595.     (target-variable (module-local-variable to as)))
  596.     (cond ((and source-variable target-variable)
  597.        ;; There are bindings for both the source and target,
  598.        ;; which prevents us from doing the import unless they
  599.        ;; happen to refer to the same variable.
  600.        (if (not (eq? source-variable target-variable))
  601.            (error "Cannot import" name 'from from '--
  602.               as 'is 'already 'present 'in to))
  603.        source-variable)
  604.       (source-variable
  605.        ;; the simple case -- just copy the source to the target
  606.        (module-add! to as source-variable)
  607.        source-variable)
  608.       ((eq? (module-package from) #f)
  609.        ;; -- semi hack alert --
  610.        ;; If there's no source variable, it's an error
  611.        ;; *unless*: the source module is a user-module or package,
  612.        ;; which should only happen during exporting; in this
  613.        ;; case we create the source variable (sort of a
  614.        ;; `forward declaration')
  615.        (error "Cannot import" name 'from from '--
  616.           'no 'such 'variable))
  617.       (target-variable
  618.        ;; Copy the target to the source (this represents a
  619.        ;; previously exported variable being re-exported
  620.        ;; before it's actually been defined).
  621.        (module-add! from name target-variable)
  622.        target-variable)
  623.       (#t
  624.        ;; Make a new variable shared between the source and
  625.        ;; target (this represents a variable being exported
  626.        ;; before it's been defined).
  627.        (let ((variable (make-undefined-variable name)))
  628.          (module-add! to as variable)
  629.          (module-add! from name variable)
  630.          variable)))))
  631.  
  632. ;;; ----------------------------------------------------------------
  633.  
  634. ;; MODULE-EXPORT -- internal
  635. ;;
  636. ;; The non-syntax exporting function.
  637. ;; 
  638. (define (module-export module intref . operators)
  639.   (apply extend-interface
  640.      (resolve-interface intref (module-package module)
  641.                 (module-export-library module))
  642.      (module-search-space module)
  643.      module
  644.      operators))
  645.  
  646. ;;; ----------------------------------------------------------------
  647. ;;; Module syntax
  648.  
  649. ;; IN-MODULE -- exported
  650. ;;
  651. ;; Sets the current module to the module called NAME in the current package,
  652. ;; creating it if necessary, and sets the default interface to an interface
  653. ;; with the same name.
  654. ;; 
  655. ;; All symbols created in this module are private unless exported.
  656. ;;
  657. ;; Any created module will use the `module-basics' interface so that further
  658. ;; module operations can be performed; to use a truly empty module, use
  659. ;; something like (set-current-module (make-module))
  660. ;;
  661. (define-neval (in-module name)
  662.   (set-current-module
  663.    (resolve-module name (module-package (current-module)) make-user-module))
  664.   (set-current-interface name))
  665.  
  666. ;; USE-INTERFACE -- exported
  667. ;;
  668. ;; Imports variables from other interfaces into the current module.
  669. ;; References to unknown interfaces are resolved by trying to load code to
  670. ;; define the interface.
  671. ;; 
  672. ;; The most common use is just (use-interface INTERFACE-NAME), but see
  673. ;; make-interface for more details on OPERATORS.
  674. ;;
  675. (define-neval (use-interface . operators)
  676.   (module-use! (current-module)
  677.            (apply make-interface
  678.               (module-search-space (current-module)) operators)))
  679.  
  680. ;; EXPORT-INTERFACE -- exported
  681. ;;
  682. ;; Exports variables from the current module into an interface called NAME,
  683. ;; according to the OPERATORS.  The most common use is (export-interface NAME
  684. ;; SYMBOL-LIST), but see make-interface for more details on OPERATORS.
  685. ;;
  686. (define-neval (export-interface name . operators)
  687.   (apply module-export (current-module) name #f operators))
  688.  
  689. ;;; ----------------------------------------------------------------
  690. ;;; Two alternative ways to define an interface, using the current interface
  691.  
  692. (define-neval (in-interface name)
  693.   (set-current-interface name))
  694.  
  695. ;; EXPORT -- exported
  696. ;;
  697. ;; Like EXPORT-INTERFACE, but implicitly uses the current interface.
  698. ;; 
  699. (define-neval (export . operators)
  700.   (apply module-export (current-module) (current-interface) #f operators))
  701.  
  702. ;; DEFINE-EXPORT -- exported
  703. ;;
  704. ;; Like DEFINE, but also exports this variable to the current interface.
  705. ;; 
  706. (define-macro (define-export . args)
  707.   (let ((define&export
  708.       (lambda (name value)
  709.         (variable-set! (import-variable name (current-module)
  710.                         name (current-interface))
  711.                value))))
  712.     `(,define&export ',(if (symbol? (car args)) (car args) (caar args))
  713.               ,(if (symbol? (car args))
  714.                (cadr args)
  715.                (cons 'lambda (cons (cdar args) (cdr args)))))))
  716.  
  717. ;;; ----------------------------------------------------------------
  718. ;;; Package/library syntax
  719.  
  720. ;; The top level interface/module name space
  721. ;;
  722. (define *root-package* (make-package))
  723.  
  724. ;; IN-PACKAGE -- exported
  725. ;; 
  726. ;; Sets the current package to the package called NAME.  Until a
  727. ;; subsequent in-module, the current module will be a special one in
  728. ;; which package definition operators can be executed.
  729. ;; 
  730. (define-neval (in-package name)
  731.   (set-current-module
  732.    (package-initial-module (resolve-module name *root-package* make-package))))
  733.  
  734. ;; USE-LIBRARY -- exported
  735. ;;
  736. ;; Extends the interface search space of the current package or module to
  737. ;; include libraries defined by OPERATORS.
  738. ;; 
  739. ;; The most common use is just (use-library LIBRARY-NAME), but see
  740. ;; make-interface for more details on OPERATORS.
  741. ;;
  742. (define-neval (use-library . operators)
  743.   (module-use! (module-search-space (current-module))
  744.            (apply make-interface *root-package* operators)))
  745.  
  746. ;; EXPORT-LIBRARY -- exported
  747. ;;
  748. ;; Exports interfaces from the current package into a library called NAME,
  749. ;; according to the OPERATORS.  The most common use is (export-library NAME
  750. ;; MODULE-LIST), but see make-interface for more details on OPERATORS.
  751. ;;
  752. (define-neval (export-library name . operators)
  753.   (apply module-export (module-package (current-module)) name operators))
  754.  
  755. ;; EXPORT-INTERFACES-TO-LIBRARY -- exported
  756. ;;
  757. ;; Asserts that all subsequent interfaces exported from this module are to be
  758. ;; themselves exported to LIBRARY.
  759. ;; 
  760. (define-neval (export-interfaces-to-library library)
  761.   (module-set-export-library! (current-module)
  762.                   (resolve-interface library *root-package*)))
  763.  
  764. ;;; ----------------------------------------------------------------
  765. ;;; Finish bootstrapping
  766.  
  767. ;; The package containing all guile-specific stuff
  768. ;;
  769. (define *guile-package* (resolve-module 'guile *root-package* make-package))
  770.  
  771. ;; Give the initial bootstrap module a name; some later file can use
  772. ;; EXPORT-INTERFACE to actually set up its interfaces.
  773. ;;
  774. (resolve-module 'guile *guile-package* (lambda () *boot-module*))
  775. (module-use! *boot-module* *module-basics-interface*); so guile can use modules
  776.  
  777. ;; Give this module (containing module stuff) a name
  778. ;;
  779. (resolve-module 'module *guile-package* (lambda () *module-module*))
  780.  
  781. ;; Errors for disallowed operations
  782. ;; 
  783. (define-macro (module-only-error . noise)
  784.   (error "This operation can only be used inside a module"))
  785. (define-macro (package-only-error . noise)
  786.   (error "This operation can only be used during package definition"))
  787.  
  788. ;; Export `basic' interfaces that each module starts out with.  These are
  789. ;; purposely very minimal -- use-interface should be used to get things like
  790. ;; normal scheme operators.
  791. ;; 
  792. (module-export *module-module*
  793.            *module-basics-interface*
  794.            '(in-module
  795.          export-interfaces-to-library
  796.          use-interface export-interface
  797.          in-interface export define-export
  798.          in-package use-library
  799.          (package-only-error export-library)))
  800. (module-export *module-module*
  801.            *package-basics-interface*
  802.            '(use-library export-library in-module in-package
  803.          (module-only-error export-interfaces-to-library)
  804.          (module-only-error use-interface)
  805.          (module-only-error export-interface)))
  806.  
  807. ;; Export a programmers interface
  808. ;;
  809. (export-interface module
  810.           (;; module user interface
  811.            in-module use-interface export-interface
  812.            in-interface export define-export
  813.  
  814.            ;; package user interface
  815.            in-package use-library export-library
  816.  
  817.            ;; 
  818.            module-export module-use!
  819.            make-interface extend-interface
  820.            current-interface set-current-interface
  821.            make-package make-user-module
  822.            find-interface find-module
  823.            *root-package*
  824.  
  825.            import-variable
  826.  
  827.            module-package module-search-space
  828.  
  829.            ;;
  830.            module-ref module-set! module-define))
  831.  
  832. (in-module guile)
  833. (export-interface module          
  834.           ;; low level module primitives from the boot module
  835.           (make-module module-uses module-uses!
  836.            module-local-variable module-variable module-bound?
  837.            module-add! module-remove!
  838.            module-for-each
  839.            current-module set-current-module))
  840.  
  841. ;; ----------------------------------------------------------------
  842.